home *** CD-ROM | disk | FTP | other *** search
/ Aminet 2 / Aminet AMIGA CDROM (1994)(Walnut Creek)[Feb 1994][W.O. 44790-1].iso / Aminet / util / gnu / emacs_src.lha / emacs-18.58 / lisp / life.elc < prev    next >
Text File  |  1992-02-21  |  5KB  |  65 lines
  1.  
  2. (provide (quote life))
  3.  
  4. (defconst life-patterns [("@@@" " @@" "@@@") ("@@@ @@@" "@@  @@ " "@@@ @@@") ("@@@ @@@" "@@   @@" "@@@ @@@") ("@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@") ("@@@@@@@@@@") ("   @@@@@@@@@@       " "     @@@@@@@@@@     " "       @@@@@@@@@@   " "@@@@@@@@@@          " "@@@@@@@@@@          ") ("@" "@" "@" "@" "@" "@" "@" "@" "@" "@" "@" "@" "@" "@" "@") ("@               @" "@               @" "@               @" "@               @" "@               @" "@               @" "@               @" "@               @" "@               @" "@               @" "@               @" "@               @" "@               @" "@               @" "@               @") ("@@               " " @@              " "  @@             " "   @@            " "    @@           " "     @@          " "      @@         " "       @@        " "        @@       " "         @@      " "          @@     " "           @@    " "            @@   " "             @@  " "              @@ " "               @@") ("@@@@@@@@@" "@   @   @" "@ @@@@@ @" "@ @   @ @" "@@@   @@@" "@ @   @ @" "@ @@@@@ @" "@   @   @" "@@@@@@@@@")] "\
  5. Vector of rectangles containing some Life startup patterns.")
  6.  
  7. (require (progn (defmacro life-life-char nil 64) (defmacro life-death-char nil (1+ (life-life-char))) (defmacro life-birth-char nil 3) (defmacro life-void-char nil 32) (defmacro life-life-string nil (char-to-string (life-life-char))) (defmacro life-death-string nil (char-to-string (life-death-char))) (defmacro life-birth-string nil (char-to-string (life-birth-char))) (defmacro life-void-string nil (char-to-string (life-void-char))) (defmacro life-not-void-regexp nil (concat "[^" (life-void-string) "
  8. ]")) (defmacro goto-beginning-of-buffer nil (quote (goto-char 1))) (defmacro maxint nil (lsh (lsh (lognot 0) 1) -1)) (defmacro goto-end-of-buffer nil (quote (goto-char (maxint)))) (defmacro increment (variable) (list (quote setq) variable (list (quote 1+) variable))) (quote life)))
  9.  
  10. (defconst life-neighbor-deltas nil)
  11.  
  12. (defconst life-window-start nil)
  13.  
  14. (defconst life-current-generation nil)
  15.  
  16. (defconst life-generation-string nil)
  17.  
  18. (defun abs (n) (byte-code "ÁWƒ [‚ ‡" [n 0] 2))
  19.  
  20. (defun life (&optional sleeptime) "\
  21. Run Conway's Life simulation.
  22. The starting pattern is randomly selected.  Prefix arg (optional first arg
  23. non-nil from a program) is the number of seconds to sleep between
  24. generations (this defaults to 1)." (interactive "p") (byte-code "Ȇ    Ä‰ˆÅ ˆÆ!ˆÁ…(ÁÇ ˆÈ ˆÉ ˆÆ!)ˆ‚‡" [sleeptime t inhibit-quit nil 1 life-setup life-display-generation life-grim-reaper life-expand-plane-if-needed life-increment-generation] 8))
  25.  
  26. (fset (quote life-mode) (quote life))
  27.  
  28. (put (quote life-mode) (quote mode-class) (quote special))
  29.  
  30. (random t)
  31.  
  32. (defun life-setup nil (byte-code "ÃÌÍÎ!Á\"ˆÏ ˆÐ ˆÃÑÒÁÓÔÕ    Ö S
  33. ׉ ˆØp!ˆÙ ˆ×bˆÚÛÃÁ#…FÜÝÁÁ#ˆ‚5ˆ×bˆÞ
  34. Šß ˆ`)Zà\"‰ˆm?…gjˆá ˆ‚YˆÞâ Sãed\"Zà\"‰ˆ×bˆä!ˆåbˆä!ˆ×bˆm?…¦ß ˆ
  35. jˆæ
  36. !ˆç`ß ˆ`\"ˆá ˆ‚‡ˆèed\"ˆé ˆê )‡" [n t case-fold-search nil mode-name major-mode truncate-lines life-current-generation life-generation-string mode-line-buffer-identification fill-column life-window-start switch-to-buffer get-buffer-create "*Life*" erase-buffer kill-all-local-variables "Life" life-mode 0 "0" ("Life: generation " life-generation-string) window-width 1 buffer-flush-undo life-insert-random-pattern re-search-forward "[^ 
  37. ]" replace-match "@" / end-of-line 2 forward-line window-height count-lines newline 8388607 move-to-column delete-region untabify life-expand-plane-if-needed life-compute-neighbor-deltas] 26))
  38.  
  39. (defun life-compute-neighbor-deltas nil (byte-code "Âà   [    T[Ä    \\[Å        TÄ    \\&‰‡" [life-neighbor-deltas fill-column list -1 2 1] 10))
  40.  
  41. (defun life-insert-random-pattern nil (byte-code "ÁÂÃÄÅ !G\"\"!ˆÆc‡" [life-patterns insert-rectangle elt % abs random 10] 8))
  42.  
  43. (defun life-increment-generation nil (byte-code "T‰ˆÂ!‰‡" [life-current-generation life-generation-string int-to-string] 3))
  44.  
  45. (defun life-grim-reaper nil (byte-code "ÈÀ!ˆÉbˆÀÀÀÀÀÊËÀÆ#…Ì`S‰ˆ…x @\\    f‰ˆ
  46. Í=ƒBΠ       TÍÉÆ%‚o
  47. ÏWƒTΠ       T
  48.  
  49. TÆ%‚o
  50. ÐWƒeΠ       T
  51. ÐÆ%‚o
  52. ÑY…o T‰ˆA‰ˆ‚#ˆ Ò>ƒƒÀ‚‹Î TÑÓÆ%ˆ‚-ˆÔÌ!?…šÕ ˆÎÉdÐÍÆ%ˆÎÉdÉÍÆ%ˆÎÉdÖÍÆ%ˆÎÉdÏÑÆ%ˆÎÉdÓÍÆ%‡" [nil point char pivot living-neighbors list t life-neighbor-deltas store-match-data 1 search-forward "@" 0 32 subst-char-in-region 3 9 64 (2 3) 65 match-beginning life-extinct-quit 2] 18))
  53.  
  54. (defun life-expand-plane-if-needed nil (byte-code "ÃčˆÅbˆÆÇÈ`É$Á#….ÅbˆÊË\"ˆÌcˆÊË\"ˆÌcˆÈ
  55. Å#‰ˆÍbˆÎÇÏ`É$Á#…YÍbˆÊË\"ˆÌcˆÊË\"ˆÌcˆÈ
  56. Å#‰‡" [fill-column t life-window-start done (byte-code "Âbˆm?…GgÃ=†Ä ˆhÃ=…@Âbˆm?….ÅcˆÄ ˆÅcˆÆ ˆ‚ˆÇ\\‰ˆÈÂ!ˆÉ ˆÊËÁ\"ˆÌ ˆ‚‡" [fill-column t 1 64 end-of-line 32 forward-char 2 scroll-left life-compute-neighbor-deltas throw done forward-line] 9) 1 search-forward "@" + 2 insert-char 32 10 8388607 search-backward -] 13))
  57.  
  58. (defun life-display-generation (sleeptime) (byte-code "bˆÂÃ!ˆÄ    !‡" [life-window-start sleeptime recenter 0 sit-for] 3))
  59.  
  60. (defun life-extinct-quit nil (byte-code "ÁÂ!ˆÃÄÀ\"‡" [nil life-display-generation 0 signal life-extinct] 4))
  61.  
  62. (put (quote life-extinct) (quote error-conditions) (quote (life-extinct quit)))
  63.  
  64. (put (quote life-extinct) (quote error-message) "All life has perished")
  65.